home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / cowboy / shootout.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-09-07  |  14.0 KB  |  388 lines
  1. VERSION 4.00
  2. Begin VB.Form frmShootOut 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H00C0C0C0&
  5.    Caption         =   "Shoot-Out"
  6.    ClientHeight    =   5400
  7.    ClientLeft      =   1620
  8.    ClientTop       =   1755
  9.    ClientWidth     =   6135
  10.    BeginProperty Font 
  11.       name            =   "MS Sans Serif"
  12.       charset         =   0
  13.       weight          =   700
  14.       size            =   8.25
  15.       underline       =   0   'False
  16.       italic          =   0   'False
  17.       strikethrough   =   0   'False
  18.    EndProperty
  19.    ForeColor       =   &H80000008&
  20.    Height          =   5805
  21.    Icon            =   "SHOOTOUT.frx":0000
  22.    KeyPreview      =   -1  'True
  23.    Left            =   1560
  24.    LinkTopic       =   "Form2"
  25.    ScaleHeight     =   5400
  26.    ScaleWidth      =   6135
  27.    Top             =   1410
  28.    Width           =   6255
  29.    Begin VB.Timer tmrMouseCntl 
  30.       Interval        =   22
  31.       Left            =   1380
  32.       Top             =   3780
  33.    End
  34.    Begin VB.CommandButton btnStart 
  35.       Appearance      =   0  'Flat
  36.       BackColor       =   &H80000005&
  37.       Caption         =   "&Start"
  38.       Height          =   375
  39.       Left            =   2580
  40.       TabIndex        =   1
  41.       Top             =   3840
  42.       Width           =   1095
  43.    End
  44.    Begin VB.Timer Timer1 
  45.       Left            =   900
  46.       Top             =   3780
  47.    End
  48.    Begin VB.PictureBox picDesert 
  49.       Appearance      =   0  'Flat
  50.       BackColor       =   &H00C0FFC0&
  51.       ForeColor       =   &H80000008&
  52.       Height          =   3315
  53.       Left            =   180
  54.       ScaleHeight     =   3285
  55.       ScaleWidth      =   5745
  56.       TabIndex        =   0
  57.       Top             =   360
  58.       Width           =   5775
  59.       Begin VB.Image imgRBullet 
  60.          Appearance      =   0  'Flat
  61.          Height          =   480
  62.          Index           =   0
  63.          Left            =   5100
  64.          Picture         =   "SHOOTOUT.frx":030A
  65.          Top             =   1440
  66.          Visible         =   0   'False
  67.          Width           =   480
  68.       End
  69.       Begin VB.Image imgLBullet 
  70.          Appearance      =   0  'Flat
  71.          Height          =   480
  72.          Index           =   0
  73.          Left            =   420
  74.          Picture         =   "SHOOTOUT.frx":0614
  75.          Top             =   1440
  76.          Visible         =   0   'False
  77.          Width           =   480
  78.       End
  79.       Begin VB.Image imgCactus 
  80.          Appearance      =   0  'Flat
  81.          Height          =   480
  82.          Index           =   1
  83.          Left            =   2880
  84.          Picture         =   "SHOOTOUT.frx":091E
  85.          Top             =   2160
  86.          Width           =   480
  87.       End
  88.       Begin VB.Image imgCactus 
  89.          Appearance      =   0  'Flat
  90.          Height          =   480
  91.          Index           =   0
  92.          Left            =   2160
  93.          Picture         =   "SHOOTOUT.frx":0C28
  94.          Top             =   480
  95.          Width           =   480
  96.       End
  97.       Begin VB.Image imgPlayer 
  98.          Appearance      =   0  'Flat
  99.          Height          =   480
  100.          Index           =   1
  101.          Left            =   4920
  102.          Picture         =   "SHOOTOUT.frx":0F32
  103.          Top             =   300
  104.          Width           =   480
  105.       End
  106.       Begin VB.Image imgPlayer 
  107.          Appearance      =   0  'Flat
  108.          Height          =   480
  109.          Index           =   0
  110.          Left            =   360
  111.          Picture         =   "SHOOTOUT.frx":123C
  112.          Top             =   2280
  113.          Width           =   480
  114.       End
  115.    End
  116.    Begin VB.Label Label4 
  117.       Alignment       =   2  'Center
  118.       Appearance      =   0  'Flat
  119.       BackColor       =   &H80000005&
  120.       BackStyle       =   0  'Transparent
  121.       Caption         =   "Player 2 uses the mouse: left button and right button clicks move player, and left mouse double-click fires gun."
  122.       ForeColor       =   &H80000008&
  123.       Height          =   495
  124.       Left            =   180
  125.       TabIndex        =   5
  126.       Top             =   4860
  127.       Width           =   5775
  128.    End
  129.    Begin VB.Label Label3 
  130.       Alignment       =   2  'Center
  131.       Appearance      =   0  'Flat
  132.       BackColor       =   &H80000005&
  133.       BackStyle       =   0  'Transparent
  134.       Caption         =   "Player 1 uses the keyboard: up and down arrow keys move player, and space bar fires gun."
  135.       ForeColor       =   &H80000008&
  136.       Height          =   495
  137.       Left            =   180
  138.       TabIndex        =   4
  139.       Top             =   4380
  140.       Width           =   5835
  141.    End
  142.    Begin VB.Label Label2 
  143.       Alignment       =   1  'Right Justify
  144.       Appearance      =   0  'Flat
  145.       BackColor       =   &H80000005&
  146.       BackStyle       =   0  'Transparent
  147.       Caption         =   "Player 2"
  148.       ForeColor       =   &H80000008&
  149.       Height          =   195
  150.       Left            =   4680
  151.       TabIndex        =   3
  152.       Top             =   120
  153.       Width           =   1215
  154.    End
  155.    Begin VB.Label Label1 
  156.       Appearance      =   0  'Flat
  157.       BackColor       =   &H80000005&
  158.       BackStyle       =   0  'Transparent
  159.       Caption         =   "Player 1"
  160.       ForeColor       =   &H80000008&
  161.       Height          =   195
  162.       Left            =   180
  163.       TabIndex        =   2
  164.       Top             =   120
  165.       Width           =   1215
  166.    End
  167.    Begin VB.Image imgRIP 
  168.       Appearance      =   0  'Flat
  169.       Height          =   480
  170.       Left            =   180
  171.       Picture         =   "SHOOTOUT.frx":1546
  172.       Top             =   3780
  173.       Visible         =   0   'False
  174.       Width           =   480
  175.    End
  176. Attribute VB_Name = "frmShootOut"
  177. Attribute VB_Creatable = False
  178. Attribute VB_Exposed = False
  179. Option Explicit
  180. '----------------------------------------------------------
  181. ' SHOOTOUT.FRM
  182. '----------------------------------------------------------
  183. ' KeyCodes for keyboard action.
  184. Const KEY_SPACE = &H20
  185. Const KEY_UP = &H26
  186. Const KEY_DOWN = &H28
  187. ' Number of Twips to move player on each key or mouse event.
  188. Const PlayerIncrement = 45
  189. ' Constants for mouse action.
  190. Const NO_BUTTON = 0
  191. Const LBUTTON = 1
  192. Const RBUTTON = 2
  193. ' Boolean that indicates if mouse button has been pressed down.
  194. Dim MouseButtonDown As Integer
  195. ' Number of bullets either player can have in use at one time.
  196. Const NUM_BULLETS = 6
  197. ' Booleans indicating if player 0 or player 1 have just fired.
  198. Dim GunFired(0 To 1) As Integer
  199. Private Sub btnStart_Click()
  200. '----------------------------------------------------------
  201. ' Start the game by enabling the main timer and hiding
  202. ' the start button.
  203. '----------------------------------------------------------
  204.     Timer1.Enabled = True
  205.     btnStart.Visible = False
  206. End Sub
  207. Private Function Collided(imgA As Image, imgB As Image) As Integer
  208. '--------------------------------------------------
  209. ' Check if the two Images intersect, using the
  210. ' IntersectRect API call.
  211. '--------------------------------------------------
  212. Dim A As tRect
  213. Dim B As tRect
  214. Dim ResultRect As tRect
  215.     ' Copy information into tRect structure
  216.     A.Left = imgA.Left
  217.     A.Top = imgA.Top
  218.     B.Left = imgB.Left
  219.     B.Top = imgB.Top
  220.     ' Calculate the right and bottoms of rectangles needed by the API call.
  221.     A.Right = A.Left + imgA.Width - 1
  222.     A.Bottom = A.Top + imgA.Height - 1
  223.     B.Right = B.Left + imgB.Width - 1
  224.     B.Bottom = B.Top + imgB.Height - 1
  225.     ' IntersectRect will only return 0 (false) if the
  226.     ' two rectangles do NOT intersect.
  227.     Collided = IntersectRect(ResultRect, A, B)
  228. End Function
  229. Private Sub Form_DblClick()
  230. '----------------------------------------------------------
  231. ' Double-clicking the mouse fires Player 1's gun.
  232. '----------------------------------------------------------
  233. Dim rc As Integer
  234.     If Not Timer1.Enabled Then Exit Sub
  235.     GunFired(1) = True
  236.     rc = sndPlaySound(App.Path & "\BANG.WAV", SND_ASYNC)
  237. End Sub
  238. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  239. '----------------------------------------------------------
  240. ' This event handles Player 0's game action via the
  241. ' keyboard.
  242. '----------------------------------------------------------
  243. Dim rc As Integer
  244. Static InKeyDown As Integer
  245.     If Not Timer1.Enabled Then Exit Sub
  246.     If InKeyDown Then Exit Sub
  247.     InKeyDown = True
  248.     ' Don't hog the cycles...
  249.     DoEvents
  250.     Select Case KeyCode
  251.         Case KEY_UP
  252.             imgPlayer(0).Top = imgPlayer(0).Top - PlayerIncrement
  253.             If imgPlayer(0).Top < 0 Then imgPlayer(0).Top = 0
  254.         Case KEY_SPACE
  255.             GunFired(0) = True
  256.             rc = sndPlaySound(App.Path & "\BANG.WAV", SND_ASYNC)
  257.         Case KEY_DOWN
  258.             imgPlayer(0).Top = imgPlayer(0).Top + PlayerIncrement
  259.             If imgPlayer(0).Top > (picDesert.ScaleHeight - imgPlayer(0).Height) Then
  260.                 imgPlayer(0).Top = picDesert.ScaleHeight - imgPlayer(0).Height
  261.             End If
  262.     End Select
  263.     InKeyDown = False
  264. End Sub
  265. Private Sub Form_Load()
  266. '----------------------------------------------------------
  267. ' Set the main timer's interval and make sure it's disabled.
  268. ' Load 5 more bullets for each player from the bullet images
  269. ' created at design time.
  270. '----------------------------------------------------------
  271. Dim i As Integer
  272.     Timer1.Interval = 22
  273.     Timer1.Enabled = False
  274.     MouseButtonDown = NO_BUTTON
  275.     For i = 1 To NUM_BULLETS - 1
  276.         Load imgLBullet(i)
  277.         Load imgRBullet(i)
  278.     Next
  279. End Sub
  280. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  281. '----------------------------------------------------------
  282. ' Set the module-level MouseButtonDown variable, so that
  283. ' the Mouse Control timer knows a button was pushed.
  284. '----------------------------------------------------------
  285.     MouseButtonDown = Button
  286. End Sub
  287. Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  288. '----------------------------------------------------------
  289. ' Let the Mouse Control timer know the button has been
  290. ' released.
  291. '----------------------------------------------------------
  292.     MouseButtonDown = NO_BUTTON
  293. End Sub
  294. Private Sub Timer1_Timer()
  295. '----------------------------------------------------------
  296. ' The main game timer.
  297. '----------------------------------------------------------
  298. Const CactusIncrement = 30
  299. Const BulletIncrement = 300
  300. Const NumCacti = 2
  301. Dim i As Integer
  302. Dim rc As Integer
  303.     ' Move the roving cacti.
  304.     For i = 0 To NumCacti - 1
  305.         imgCactus(i).Top = imgCactus(i).Top - CactusIncrement
  306.         If imgCactus(i).Top < -imgCactus(i).Height Then
  307.             imgCactus(i).Top = picDesert.Height
  308.         End If
  309.     Next
  310.     ' Did player 0 fire a bullet?
  311.     If GunFired(0) Then
  312.         GunFired(0) = False
  313.         ' Find a spare (invisible) bullet.
  314.         For i = 0 To NUM_BULLETS - 1
  315.             If Not imgLBullet(i).Visible Then
  316.                 imgLBullet(i).Top = imgPlayer(0).Top
  317.                 imgLBullet(i).Left = imgPlayer(0).Left + (imgPlayer(0).Width / 2)
  318.                 imgLBullet(i).Visible = True
  319.                 Exit For
  320.             End If
  321.         Next
  322.     End If
  323.     ' Did player 1 fire a bullet?
  324.     If GunFired(1) Then
  325.         GunFired(1) = False
  326.         ' Find a spare (invisible) bullet.
  327.         For i = 0 To NUM_BULLETS - 1
  328.             If Not imgRBullet(i).Visible Then
  329.                 imgRBullet(i).Top = imgPlayer(1).Top
  330.                 imgRBullet(i).Left = imgPlayer(1).Left - (imgPlayer(1).Width / 2)
  331.                 imgRBullet(i).Visible = True
  332.                 Exit For
  333.             End If
  334.         Next
  335.     End If
  336.     ' Move Visible Bullets
  337.     For i = 0 To NUM_BULLETS - 1
  338.         ' Move player 0's bullets.
  339.         If imgLBullet(i).Visible Then
  340.             imgLBullet(i).Left = imgLBullet(i).Left + BulletIncrement
  341.             If Collided(imgLBullet(i), imgCactus(0)) Then
  342.                 imgLBullet(i).Visible = False
  343.             ElseIf Collided(imgLBullet(i), imgCactus(1)) Then
  344.                 imgLBullet(i).Visible = False
  345.             ElseIf imgLBullet(i).Left > picDesert.ScaleWidth Then
  346.                 imgLBullet(i).Visible = False
  347.             ElseIf Collided(imgLBullet(i), imgPlayer(1)) Then
  348.                 imgLBullet(i).Visible = False
  349.                 imgPlayer(1).Picture = imgRIP.Picture
  350.                 Timer1.Enabled = False
  351.                 rc = sndPlaySound(App.Path & "\OH!!.WAV", SND_ASYNC)
  352.             End If
  353.         End If
  354.         ' Move player 1's bullets.
  355.         If imgRBullet(i).Visible Then
  356.             imgRBullet(i).Left = imgRBullet(i).Left - BulletIncrement
  357.             If Collided(imgRBullet(i), imgCactus(0)) Then
  358.                 imgRBullet(i).Visible = False
  359.             ElseIf Collided(imgRBullet(i), imgCactus(1)) Then
  360.                 imgRBullet(i).Visible = False
  361.             ElseIf imgRBullet(i).Left < -imgRBullet(i).Width Then
  362.                 imgRBullet(i).Visible = False
  363.             ElseIf Collided(imgRBullet(i), imgPlayer(0)) Then
  364.                 imgRBullet(i).Visible = False
  365.                 imgPlayer(0).Picture = imgRIP.Picture
  366.                 Timer1.Enabled = False
  367.                 rc = sndPlaySound(App.Path & "\OH!!.WAV", SND_ASYNC)
  368.             End If
  369.         End If
  370.     Next
  371. End Sub
  372. Private Sub tmrMouseCntl_Timer()
  373. '----------------------------------------------------------
  374. ' Handle Player 1's movement (up and down).
  375. '----------------------------------------------------------
  376.     If Not Timer1.Enabled Then Exit Sub
  377.     Select Case MouseButtonDown
  378.         Case RBUTTON
  379.             imgPlayer(1).Top = imgPlayer(1).Top - PlayerIncrement
  380.             If imgPlayer(1).Top < 0 Then imgPlayer(1).Top = 0
  381.         Case LBUTTON
  382.             imgPlayer(1).Top = imgPlayer(1).Top + PlayerIncrement
  383.             If imgPlayer(1).Top > (picDesert.ScaleHeight - imgPlayer(1).Height) Then
  384.                 imgPlayer(1).Top = picDesert.ScaleHeight - imgPlayer(1).Height
  385.             End If
  386.     End Select
  387. End Sub
  388.